Tips&Tricks | I trucchi del mestiere |
![]() |
Come sfumare lo sfondo |
#include |
![]() |
Come mostrare i font durante la selezione |
For I = 0 To Screen.FontCount - 1 ' Put each font into list box. cboFont.AddItem Screen.Fonts(I) Next I |
Private Sub cboFont_Click() 'Set the FontName of the combo box 'to the font that was selected. cboFont.FontName = cboFont.Text End Sub |
![]() |
Come salvare la dimensione e la posizione di una Form |
Public Const ApplicationName = "Nome Applicazione" |
Call LoadFormDisplaySettings(Me) |
Call SaveFormDisplaySettings(Me) |
HKEY_CURRENT_USER\Software\VB and VBA Program Settings\My Application Name\. |
Public Sub SaveFormDisplaySettings(frm As Form) If frm.Tag = "" Then Exit Sub SaveSetting ApplicationName, frm.Tag & _ " Display Settings", "Top", Str(frm.Top) SaveSetting ApplicationName, frm.Tag & _ " Display Settings", "Left", Str(frm.Left) SaveSetting ApplicationName, frm.Tag & _ " Display Settings", "Height", Str(frm.Height) SaveSetting ApplicationName, frm.Tag & _ " Display Settings", "Width", Str(frm.Width) End Sub Public Sub LoadFormDisplaySettings(frm As Form) Dim FormSettings As Variant Dim intSettings As Integer If frm.Tag = "" Then Exit Sub FormSettings = GetAllSettings(ApplicationName, frm.Tag & _ " Display Settings") If IsEmpty(FormSettings) Then Exit Sub For intSettings = LBound(FormSettings, 1) _ To UBound(FormSettings, 1) Select Case FormSettings(intSettings, 0) Case "Left" frm.Left = Val(FormSettings(intSettings, 1)) Case "Top" frm.Top = Val(FormSettings(intSettings, 1)) Case "Height" frm.Height = Val(FormSettings(intSettings, 1)) Case "Width" frm.Width = Val(FormSettings(intSettings, 1)) End Select Next intSettings End Sub |
![]() |
Come controllare l'input |
Option Explicit Private strClipboardText As String Private Sub txtNumberBox_KeyPress(KeyAscii As Integer) If (KeyAscii <= Asc("0") Or KeyAscii >= Asc("9")) And KeyAscii <> vbKeyBack Then KeyAscii = 0 End If End Sub Private Sub txtNumberBox_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ' User can paste char values by pasting contents of clipboard, which should be prevented. strClipboardText = Clipboard.GetText If Not IsNumeric(strClipboardText) Then Clipboard.Clear End Sub Private Sub txtNumberBox_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) ' If there was any char value in clipboard and was cleared, restore that Value If Not IsNumeric(strClipboardText) Then Clipboard.SetText strClipboardText End Sub |
![]() |
Come ordinare un array |
Private Sub BubbleSort(varArray As Variant, bAscending As Boolean) 'Option Base 0 is assumed Dim HoldEntry As Integer Dim SwapOccurred As Boolean Dim iItteration As Integer Dim i As Integer SwapOccurred = True iItteration = 1 Do Until Not SwapOccurred SwapOccurred = False For i = LBound(varArray) To UBound(varArray) - iItteration Step 1 If bAscending Then If varArray(i) > varArray(i + 1) Then HoldEntry = varArray(i) varArray(i) = varArray(i + 1) varArray(i + 1) = HoldEntry SwapOccurred = True End If Else If varArray(i + 1) > varArray(i) Then HoldEntry = varArray(i) varArray(i) = varArray(i + 1) varArray(i + 1) = HoldEntry SwapOccurred = True End If End If Next i iItteration = iItteration + 1 'reduce iteration each time as greatest/lowest 'item already at end/start of array Loop End Sub 'to call .... Private Sub cmdBubbleSort_Click() Dim lArray(999) As Long, iCnt As Integer 'populate array with dummy data For iCnt = LBound(lArray) To UBound(lArray) Step 1 lArray(iCnt) = Int((1000 * Rnd) + 1) Next iCnt Call BubbleSort(lArray, True) 'display result For iCnt = LBound(lArray) To UBound(lArray) Step 1 lstResult.AddItem lArray(iCnt) Next iCnt End Sub |
![]() |
Come chiudere tutte le Form |
Dim f As Form For Each f In Forms If f.hwnd <> Me.hwnd Then Unload f End If Next |
![]() |
Come cancellare un elemento in un array |
Dim f As Form ' Element to delete iDelete = 5 ' Number of elements before deletion nElements = UBound(Array) ' Replace iDelete with last item in array Array(iDelete) = Array(nElements) ' Use ReDim Preserve to shrink array by one ReDim Preserve Array(LBound(Array) To nElements - 1) |
![]() |
Come verificare l'esistenza di un file |
If Dir$("C:\WINDOWS\WIN.INI") <> "" Then 'file Win.ini exists! Else 'file Win.ini does not exist! End If |